Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue41/Patterns/HVTimeKeeper.pas

Pascal/Delphi Source File | 1998-11-18 | 3.7 KB | 155 lines

unit HVTimeKeeper;

interface

uses
  SysUtils;

type
  ESingleton = class(Exception);

  TInvalidateDestroy = class(TObject)
  protected
    class procedure SingletonError;
  public
    destructor Destroy; override;
  end;

  TTimeKeeper = class;
  TTimeKeeperClass = class of TTimeKeeper;
  TTimeKeeper = class(TInvalidateDestroy)
  private
    class procedure Shutdown;
    function GetTime: TDateTime;
    function GetDate: TDateTime;
    function GetNow: TDateTime;
  protected
    // Allow descendents to set a new class for the instance:
    class procedure SetTimeKeeperClass(aTimeKeeperClass: TTimeKeeperClass);
    // Actual constructor and destructor that will be used:
    constructor SingletonCreate; virtual;
    destructor SingletonDestroy; virtual;
  public
    // Not for use - for obstruction only:
    class procedure Create;
    class procedure Free(Dummy: integer);
{$IFNDEF VER120} {$WARNINGS OFF} {$ENDIF}
    // This generates a warning in D3. D4 has the reintroduce keyword to solve this
    class procedure Destroy(Dummy: integer); {$IFDEF VER120} reintroduce; {$ENDIF}
    // Simple interface:
    class function Instance: TTimeKeeper;
    property Time: TDateTime read GetTime;
    property Date: TDateTime read GetDate;
    property Now: TDateTime read GetNow;
  end;
{$IFNDEF VER120} {$WARNINGS ON} {$ENDIF}

function TimeKeeper: TTimeKeeper;

implementation

class procedure TInvalidateDestroy.SingletonError;
// Raise an exception in case of illegal use
begin
  raise ESingleton.CreateFmt('Illegal use of %s singleton instance!', [ClassName]);
end;

destructor TInvalidateDestroy.Destroy;
// Protected against use of default destructor
begin
  SingletonError;
end;

{ TTimeKeeper }

var
  TimeKeeperInstance: TTimeKeeper = nil;
  TimeKeeperClass: TTimeKeeperClass = TTimeKeeper;

class procedure TTimeKeeper.SetTimeKeeperClass(aTimeKeeperClass: TTimeKeeperClass);
// Allow change of instance class
begin
  Assert(Assigned(aTimeKeeperClass));
  if Assigned(TimeKeeperInstance) then
    SingletonError;
  TimeKeeperClass := aTimeKeeperClass;
end;

class function TTimeKeeper.Instance: TTimeKeeper;
// Single Instance function - create when first needed
begin
  Assert(Assigned(TimeKeeperClass));
  if not Assigned(TimeKeeperInstance) then
    TimeKeeperInstance := TimeKeeperClass.SingletonCreate;
  Result := TimeKeeperInstance;
end;

class procedure TTimeKeeper.Shutdown;
// Time to close down the show
begin
  if Assigned(TimeKeeperInstance) then
  begin
    TimeKeeperInstance.SingletonDestroy;
    TimeKeeperInstance := nil;
  end;
end;

constructor TTimeKeeper.SingletonCreate;
// Protected constructor
begin
  inherited Create;
end;

destructor TTimeKeeper.SingletonDestroy;
// Protected destructor
begin
  // We cannot call inherited Destroy; here!
  // It would raise an ESingleton exception
end;

// Protected against use of default constructor
class procedure TTimeKeeper.Create;
begin
  SingletonError;
end;

// Protected against use of Free
class procedure TTimeKeeper.Free(Dummy: integer);
begin
  SingletonError;
end;

class procedure TTimeKeeper.Destroy(Dummy: integer);
begin
  SingletonError;
end;

// Property access methods
function TTimeKeeper.GetDate: TDateTime;
begin
  Result := SysUtils.Date;
end;

function TTimeKeeper.GetNow: TDateTime;
begin
  Result := SysUtils.Now;
end;

function TTimeKeeper.GetTime: TDateTime;
begin
  Result := SysUtils.Time;
end;

// Simplified functional interface

function TimeKeeper: TTimeKeeper;
begin
  Result := TTimeKeeper.Instance;
end;

initialization
finalization
// Destroy when application closes
  TTimeKeeper.Shutdown;
end.